New Star Software Collection/NSS_Collection.iso/3-004 ms visual basic pro 30/4.imz/4.IMA/INDEXADD.FR_/INDEXADD.bin

Text File | 1993-04-28 | 7KB | 261 lines

VERSION 2.00
Begin Form fIndexAdd
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Add Index"
   ClientHeight    =   2775
   ClientLeft      =   3855
   ClientTop       =   3795
   ClientWidth     =   4905
   ControlBox      =   0   'False
   ForeColor       =   &H00C0C0C0&
   Height          =   3180
   Left            =   3795
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2760
   ScaleMode       =   0  'User
   ScaleWidth      =   4932
   Top             =   3450
   Width           =   5025
   Begin CheckBox cPrimaryFlag
      BackColor       =   &H00C0C0C0&
      Caption         =   "Primary"
      Height          =   252
      Left            =   3570
      TabIndex        =   9
      Top             =   105
      Value           =   1  'Checked
      Width           =   1092
   End
   Begin TextBox cIndexName
      BackColor       =   &H00FFFFFF&
      Height          =   288
      Left            =   960
      TabIndex        =   0
      Tag             =   "OL"
      Top             =   120
      Width           =   2532
   End
   Begin TextBox cFieldNames
      BackColor       =   &H00FFFFFF&
      Height          =   528
      Left            =   960
      MultiLine       =   -1  'True
      TabIndex        =   1
      Tag             =   "OL"
      Top             =   480
      Width           =   2532
   End
   Begin ListBox cFieldList
      BackColor       =   &H00FFFFFF&
      Columns         =   2
      Height          =   1590
      Left            =   960
      Sorted          =   -1  'True
      TabIndex        =   7
      Tag             =   "OL"
      Top             =   1080
      Width           =   2535
   End
   Begin CheckBox cUniqueFlag
      BackColor       =   &H00C0C0C0&
      Caption         =   "Unique"
      Height          =   252
      Left            =   3570
      TabIndex        =   8
      Top             =   525
      Value           =   1  'Checked
      Width           =   1092
   End
   Begin CommandButton OkayButton
      BackColor       =   &H00C0C0C0&
      Caption         =   "&OK"
      Default         =   -1  'True
      Enabled         =   0   'False
      Height          =   372
      Left            =   3600
      TabIndex        =   4
      Top             =   1320
      Width           =   1212
   End
   Begin CommandButton CloseButton
      BackColor       =   &H00C0C0C0&
      Cancel          =   -1  'True
      Caption         =   "&Close"
      Height          =   372
      Left            =   3600
      TabIndex        =   5
      Top             =   1920
      Width           =   1212
   End
   Begin Label FieldListLabel
      BackColor       =   &H00C0C0C0&
      Caption         =   "Fields:"
      Height          =   252
      Left            =   120
      TabIndex        =   6
      Top             =   1080
      Width           =   732
   End
   Begin Label FieldsLabel
      BackColor       =   &H00C0C0C0&
      Caption         =   "Indexed Fields:"
      Height          =   492
      Left            =   120
      TabIndex        =   3
      Top             =   480
      Width           =   732
   End
   Begin Label NameLabel
      BackColor       =   &H00C0C0C0&
      Caption         =   "Name:"
      Height          =   252
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   732
   End
End
Option Explicit

Sub cFieldList_Click ()
  Dim s As String

  s = cFieldNames
  If s = "" Then
    cFieldNames = s + cFieldList
  Else
    cFieldNames = s + ";" + cFieldList
  End If
  cFieldNames.Refresh
End Sub

Sub cFieldNames_Change ()
  If cIndexName <> "" And cFieldNames <> "" Then
    OkayButton.Enabled = True
  Else
    OkayButton.Enabled = False
  End If
End Sub

Sub cFieldNames_LostFocus ()
  If cIndexName <> "" And cFieldNames <> "" Then
    OkayButton.Enabled = True
  Else
    OkayButton.Enabled = False
  End If
End Sub

Sub cIndexName_LostFocus ()
  If cIndexName <> "" And cFieldNames <> "" Then
    OkayButton.Enabled = True
  Else
    OkayButton.Enabled = False
  End If
End Sub

Sub CloseButton_Click ()
  Unload Me
End Sub

Sub Form_Load ()
  Dim t As TableDef
  Dim i As Integer

  If gfAddTableFlag = True Then
    Caption = Caption + " to " + fTblStru.cTableName
    fTblStru.cFields.Col = 0
    For i = 1 To fTblStru.cFields.Rows - 1
      fTblStru.cFields.Row = i
      cFieldList.AddItem fTblStru.cFields
    Next
  Else
    Caption = Caption + " to " + fTables.cTableList
    Set t = gCurrentDB.TableDefs(fTables.cTableList)
    For i = 0 To t.Fields.Count - 1
      cFieldList.AddItem t.Fields(i).Name
    Next
  End If

End Sub

Sub Form_Paint ()
  Outlines Me
End Sub

Sub IndexName_Change ()
  If cIndexName <> "" And cFieldNames <> "" Then
    OkayButton.Enabled = True
  Else
    OkayButton.Enabled = False
  End If
End Sub

Sub OkayButton_Click ()
  Dim i As New Index
  Dim t As TableDef
  Dim s As String

  On Error GoTo AddIndexErr

  SetHourglass Me

  i.Name = cIndexName
  i.Fields = cFieldNames
  i.Unique = cUniqueFlag
  If gstDataType <> "ODBC" Then i.Primary = cPrimaryFlag

  If gfAddTableFlag = False Then
    Set t = gCurrentDB.TableDefs(fTables.cTableList)
    t.Indexes.Append i
  End If
  fTblStru.cIndexes.Row = 1
  fTblStru.cIndexes.Col = 0
  If fTblStru.cIndexes <> "" Then
    'add a row if the first one isn't blank
    fTblStru.cIndexes.Rows = fTblStru.cIndexes.Rows + 1
  End If
  fTblStru.cIndexes.Row = fTblStru.cIndexes.Rows - 1
  fTblStru.cIndexes.Col = 0
  fTblStru.cIndexes = cIndexName
  fTblStru.cIndexes.Col = 1
  fTblStru.cIndexes = cFieldNames
  fTblStru.cIndexes.Col = 2
  If i.Unique = False Then
    s = "False"
  Else
    s = "True"
  End If
  fTblStru.cIndexes = s
  fTblStru.cIndexes.Col = 3
  If gstDataType = "ODBC" Then
    s = "N/A"
  Else
    If i.Primary = False Then
      s = "False"
    Else
      s = "True"
    End If
  End If
  fTblStru.cIndexes = s

  'reset the field for another
  cIndexName = ""
  cIndexName.SetFocus
  cFieldNames = ""
  cUniqueFlag = 1

  GoTo AddIndexEnd

AddIndexErr:
  ShowError
  Resume AddIndexEnd

AddIndexEnd:
  ResetMouse Me

End Sub